home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch13 / Platonic.frm (.txt) < prev    next >
Visual Basic Form  |  1999-07-12  |  11KB  |  330 lines
  1. VERSION 5.00
  2. Begin VB.Form frmPlatonic 
  3.    Appearance      =   0  'Flat
  4.    BackColor       =   &H00C0C0C0&
  5.    Caption         =   "Platonic"
  6.    ClientHeight    =   4230
  7.    ClientLeft      =   1395
  8.    ClientTop       =   1140
  9.    ClientWidth     =   5850
  10.    BeginProperty Font 
  11.       Name            =   "MS Sans Serif"
  12.       Size            =   8.25
  13.       Charset         =   0
  14.       Weight          =   700
  15.       Underline       =   0   'False
  16.       Italic          =   0   'False
  17.       Strikethrough   =   0   'False
  18.    EndProperty
  19.    ForeColor       =   &H80000008&
  20.    KeyPreview      =   -1  'True
  21.    LinkTopic       =   "Form1"
  22.    PaletteMode     =   1  'UseZOrder
  23.    ScaleHeight     =   4230
  24.    ScaleWidth      =   5850
  25.    Begin VB.CheckBox Choice 
  26.       Caption         =   "Dodecahedron"
  27.       Height          =   255
  28.       Index           =   4
  29.       Left            =   4320
  30.       TabIndex        =   4
  31.       TabStop         =   0   'False
  32.       Top             =   1560
  33.       Width           =   1575
  34.    End
  35.    Begin VB.CheckBox Choice 
  36.       Caption         =   "Icosahedron"
  37.       Height          =   255
  38.       Index           =   5
  39.       Left            =   4320
  40.       TabIndex        =   5
  41.       TabStop         =   0   'False
  42.       Top             =   1920
  43.       Width           =   1575
  44.    End
  45.    Begin VB.CheckBox Choice 
  46.       Caption         =   "Cube"
  47.       Height          =   255
  48.       Index           =   2
  49.       Left            =   4320
  50.       TabIndex        =   2
  51.       TabStop         =   0   'False
  52.       Top             =   840
  53.       Value           =   1  'Checked
  54.       Width           =   1575
  55.    End
  56.    Begin VB.CheckBox Choice 
  57.       Caption         =   "Octahedron"
  58.       Height          =   255
  59.       Index           =   3
  60.       Left            =   4320
  61.       TabIndex        =   3
  62.       TabStop         =   0   'False
  63.       Top             =   1200
  64.       Width           =   1575
  65.    End
  66.    Begin VB.CheckBox Choice 
  67.       Caption         =   "Axes"
  68.       Height          =   255
  69.       Index           =   0
  70.       Left            =   4320
  71.       TabIndex        =   0
  72.       TabStop         =   0   'False
  73.       Top             =   0
  74.       Value           =   1  'Checked
  75.       Width           =   1575
  76.    End
  77.    Begin VB.CheckBox Choice 
  78.       Caption         =   "Tetrahedron"
  79.       Height          =   255
  80.       Index           =   1
  81.       Left            =   4320
  82.       TabIndex        =   1
  83.       TabStop         =   0   'False
  84.       Top             =   480
  85.       Width           =   1575
  86.    End
  87.    Begin VB.PictureBox picCanvas 
  88.       AutoRedraw      =   -1  'True
  89.       Height          =   4215
  90.       Left            =   0
  91.       ScaleHeight     =   -4
  92.       ScaleLeft       =   -2
  93.       ScaleMode       =   0  'User
  94.       ScaleTop        =   2
  95.       ScaleWidth      =   4
  96.       TabIndex        =   6
  97.       Top             =   0
  98.       Width           =   4215
  99.    End
  100. Attribute VB_Name = "frmPlatonic"
  101. Attribute VB_GlobalNameSpace = False
  102. Attribute VB_Creatable = False
  103. Attribute VB_PredeclaredId = True
  104. Attribute VB_Exposed = False
  105. Option Explicit
  106. ' Location of viewing eye.
  107. Private EyeR As Single
  108. Private EyeTheta As Single
  109. Private EyePhi As Single
  110. ' Location of focus point.
  111. Private Const FocusX = 0#
  112. Private Const FocusY = 0#
  113. Private Const FocusZ = 0#
  114. Private Projector(1 To 4, 1 To 4) As Single
  115. Private FirstTet As Integer
  116. Private FirstCube As Integer
  117. Private FirstOct As Integer
  118. Private FirstDod As Integer
  119. Private FirstIco As Integer
  120. Private LastIco As Integer
  121. ' Project and draw the cube.
  122. Private Sub DrawData(pic As Object)
  123. Dim i As Integer
  124.     ' Transform the points.
  125.     TransformAllDataFull Projector
  126.     ' Draw the points.
  127.     pic.Cls
  128.     If Choice(0).value = vbChecked Then DrawSomeData pic, 1, FirstTet - 1, vbBlack, False
  129.     If Choice(1).value = vbChecked Then DrawSomeData pic, FirstTet, FirstCube - 1, vbRed, False
  130.     If Choice(2).value = vbChecked Then DrawSomeData pic, FirstCube, FirstOct - 1, RGB(0, 128, 0), False
  131.     If Choice(3).value = vbChecked Then DrawSomeData pic, FirstOct, FirstDod - 1, vbBlue, False
  132.     If Choice(4).value = vbChecked Then DrawSomeData pic, FirstDod, FirstIco - 1, vbMagenta, False
  133.     If Choice(5).value = vbChecked Then DrawSomeData pic, FirstIco, LastIco, RGB(0, 128, 128), False
  134.     pic.Refresh
  135. End Sub
  136. Private Sub Choice_Click(Index As Integer)
  137.     DrawData picCanvas
  138. End Sub
  139. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  140. Const Dtheta = PI / 20
  141.     Select Case KeyCode
  142.         Case vbKeyLeft
  143.             EyeTheta = EyeTheta - Dtheta
  144.         Case vbKeyRight
  145.             EyeTheta = EyeTheta + Dtheta
  146.         Case vbKeyUp
  147.             EyePhi = EyePhi - Dtheta
  148.         Case vbKeyDown
  149.             EyePhi = EyePhi + Dtheta
  150.         Case Else
  151.             Exit Sub
  152.     End Select
  153.     m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
  154.     DrawData picCanvas
  155. End Sub
  156. Private Sub Form_Load()
  157.     ' Initialize the eye position.
  158.     EyeR = 5
  159.     EyeTheta = PI * 0.4
  160.     EyePhi = PI * 0.1
  161.     ' Initialize the projection transformation.
  162.     m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
  163.     ' Create the data.
  164.     CreateData
  165.     ' Project and draw the data.
  166.     DrawData picCanvas
  167. End Sub
  168. ' Create the data.
  169. Private Sub CreateData()
  170. Dim theta1 As Single
  171. Dim theta2 As Single
  172. Dim s1 As Single
  173. Dim s2 As Single
  174. Dim c1 As Single
  175. Dim c2 As Single
  176. Dim S As Single
  177. Dim R As Single
  178. Dim H As Single
  179. Dim A As Single
  180. Dim B As Single
  181. Dim C As Single
  182. Dim D As Single
  183. Dim X As Single
  184. Dim Y As Single
  185. Dim y2 As Single
  186. Dim M As Single
  187. Dim N As Single
  188.     ' Axes.
  189.     MakeSegment 0, 0, 0, 0.5, 0, 0  ' X axis.
  190.     MakeSegment 0, 0, 0, 0, 0.5, 0  ' Y axis.
  191.     MakeSegment 0, 0, 0, 0, 0, 0.5  ' Z axis.
  192.     ' Tetrahedron.
  193.     FirstTet = NumSegments + 1
  194.     S = Sqr(6)
  195.     A = S / Sqr(3)
  196.     B = -A / 2
  197.     C = A * Sqr(2) - 1
  198.     D = S / 2
  199.     MakeSegment 0, C, 0, A, -1, 0
  200.     MakeSegment 0, C, 0, B, -1, D
  201.     MakeSegment 0, C, 0, B, -1, -D
  202.     MakeSegment B, -1, -D, B, -1, D
  203.     MakeSegment B, -1, D, A, -1, 0
  204.     MakeSegment A, -1, 0, B, -1, -D
  205.     ' Cube.
  206.     FirstCube = NumSegments + 1
  207.     MakeSegment -1, -1, -1, -1, 1, -1
  208.     MakeSegment -1, 1, -1, 1, 1, -1
  209.     MakeSegment 1, 1, -1, 1, -1, -1
  210.     MakeSegment 1, -1, -1, -1, -1, -1
  211.     MakeSegment -1, -1, 1, -1, 1, 1
  212.     MakeSegment -1, 1, 1, 1, 1, 1
  213.     MakeSegment 1, 1, 1, 1, -1, 1
  214.     MakeSegment 1, -1, 1, -1, -1, 1
  215.     MakeSegment -1, -1, -1, -1, -1, 1
  216.     MakeSegment -1, 1, -1, -1, 1, 1
  217.     MakeSegment 1, 1, -1, 1, 1, 1
  218.     MakeSegment 1, -1, -1, 1, -1, 1
  219.     ' Octahedron.
  220.     FirstOct = NumSegments + 1
  221.     MakeSegment 0, 1, 0, 1, 0, 0
  222.     MakeSegment 0, 1, 0, -1, 0, 0
  223.     MakeSegment 0, 1, 0, 0, 0, 1
  224.     MakeSegment 0, 1, 0, 0, 0, -1
  225.     MakeSegment 0, -1, 0, 1, 0, 0
  226.     MakeSegment 0, -1, 0, -1, 0, 0
  227.     MakeSegment 0, -1, 0, 0, 0, 1
  228.     MakeSegment 0, -1, 0, 0, 0, -1
  229.     MakeSegment 0, 0, 1, 1, 0, 0
  230.     MakeSegment 0, 0, 1, -1, 0, 0
  231.     MakeSegment 0, 0, -1, 1, 0, 0
  232.     MakeSegment 0, 0, -1, -1, 0, 0
  233.     ' Dodecahedron.
  234.     FirstDod = NumSegments + 1
  235.     theta1 = PI * 0.4
  236.     theta2 = PI * 0.8
  237.     s1 = Sin(theta1)
  238.     c1 = Cos(theta1)
  239.     s2 = Sin(theta2)
  240.     c2 = Cos(theta2)
  241.     M = 1 - (2 - 2 * c1 - 4 * s1 * s1) / (2 * c1 - 2)
  242.     N = Sqr((2 - 2 * c1) - M * M) * (1 + (1 - c2) / (c1 - c2))
  243.     R = 2 / N
  244.     S = R * Sqr(2 - 2 * c1)
  245.     A = R * s1
  246.     B = R * s2
  247.     C = R * c1
  248.     D = R * c2
  249.     H = R * (c1 - s1)
  250.     X = (R * R * (2 - 2 * c1) - 4 * A * A) / (2 * C - 2 * R)
  251.     Y = Sqr(S * S - (R - X) * (R - X))
  252.     y2 = Y * (1 - c2) / (c1 - c2)
  253.     MakeSegment R, 1, 0, C, 1, A        ' Top
  254.     MakeSegment C, 1, A, D, 1, B
  255.     MakeSegment D, 1, B, D, 1, -B
  256.     MakeSegment D, 1, -B, C, 1, -A
  257.     MakeSegment C, 1, -A, R, 1, 0
  258.     MakeSegment R, 1, 0, X, 1 - Y, 0    ' Top downward edges.
  259.     MakeSegment C, 1, A, X * c1, 1 - Y, X * s1
  260.     MakeSegment C, 1, -A, X * c1, 1 - Y, -X * s1
  261.     MakeSegment D, 1, B, X * c2, 1 - Y, X * s2
  262.     MakeSegment D, 1, -B, X * c2, 1 - Y, -X * s2
  263.     MakeSegment X, 1 - Y, 0, -X * c2, 1 - y2, -X * s2   ' Middle.
  264.     MakeSegment X, 1 - Y, 0, -X * c2, 1 - y2, X * s2
  265.     MakeSegment X * c1, 1 - Y, X * s1, -X * c2, 1 - y2, X * s2
  266.     MakeSegment X * c1, 1 - Y, X * s1, -X * c1, 1 - y2, X * s1
  267.     MakeSegment X * c2, 1 - Y, X * s2, -X * c1, 1 - y2, X * s1
  268.     MakeSegment X * c2, 1 - Y, X * s2, -X, 1 - y2, 0
  269.     MakeSegment X * c2, 1 - Y, -X * s2, -X, 1 - y2, 0
  270.     MakeSegment X * c2, 1 - Y, -X * s2, -X * c1, 1 - y2, -X * s1
  271.     MakeSegment X * c1, 1 - Y, -X * s1, -X * c1, 1 - y2, -X * s1
  272.     MakeSegment X * c1, 1 - Y, -X * s1, -X * c2, 1 - y2, -X * s2
  273.         
  274.     MakeSegment -R, -1, 0, -X, 1 - y2, 0    ' Bottom upward edges.
  275.     MakeSegment -C, -1, A, -X * c1, 1 - y2, X * s1 ' Bottom upward edges.
  276.     MakeSegment -D, -1, B, -X * c2, 1 - y2, X * s2
  277.     MakeSegment -D, -1, -B, -X * c2, 1 - y2, -X * s2
  278.     MakeSegment -C, -1, -A, -X * c1, 1 - y2, -X * s1
  279.     MakeSegment -R, -1, 0, -C, -1, A    ' Bottom
  280.     MakeSegment -C, -1, A, -D, -1, B
  281.     MakeSegment -D, -1, B, -D, -1, -B
  282.     MakeSegment -D, -1, -B, -C, -1, -A
  283.     MakeSegment -C, -1, -A, -R, -1, 0
  284.     ' Icosahedron.
  285.     FirstIco = NumSegments + 1
  286.     R = 2 / (2 * Sqr(1 - 2 * c1) + Sqr(3 / 4 * (2 - 2 * c1) - 2 * c2 - c2 * c2 - 1))
  287.     S = R * Sqr(2 - 2 * c1)
  288.     H = 1 - Sqr(S * S - R * R)
  289.     A = R * s1
  290.     B = R * s2
  291.     C = R * c1
  292.     D = R * c2
  293.     MakeSegment R, H, 0, C, H, A        ' Top
  294.     MakeSegment C, H, A, D, H, B
  295.     MakeSegment D, H, B, D, H, -B
  296.     MakeSegment D, H, -B, C, H, -A
  297.     MakeSegment C, H, -A, R, H, 0
  298.     MakeSegment R, H, 0, 0, 1, 0        ' Point
  299.     MakeSegment C, H, A, 0, 1, 0
  300.     MakeSegment D, H, B, 0, 1, 0
  301.     MakeSegment D, H, -B, 0, 1, 0
  302.     MakeSegment C, H, -A, 0, 1, 0
  303.     MakeSegment -R, -H, 0, -C, -H, A    ' Bottom
  304.     MakeSegment -C, -H, A, -D, -H, B
  305.     MakeSegment -D, -H, B, -D, -H, -B
  306.     MakeSegment -D, -H, -B, -C, -H, -A
  307.     MakeSegment -C, -H, -A, -R, -H, 0
  308.     MakeSegment -R, -H, 0, 0, -1, 0     ' Point
  309.     MakeSegment -C, -H, A, 0, -1, 0
  310.     MakeSegment -D, -H, B, 0, -1, 0
  311.     MakeSegment -D, -H, -B, 0, -1, 0
  312.     MakeSegment -C, -H, -A, 0, -1, 0
  313.     MakeSegment R, H, 0, -D, -H, B      ' Middle
  314.     MakeSegment R, H, 0, -D, -H, -B
  315.     MakeSegment C, H, A, -D, -H, B
  316.     MakeSegment C, H, A, -C, -H, A
  317.     MakeSegment D, H, B, -C, -H, A
  318.     MakeSegment D, H, B, -R, -H, 0
  319.     MakeSegment D, H, -B, -R, -H, 0
  320.     MakeSegment D, H, -B, -C, -H, -A
  321.     MakeSegment C, H, -A, -C, -H, -A
  322.     MakeSegment C, H, -A, -D, -H, -B
  323.     LastIco = NumSegments
  324.     If Not SameSideLengths(FirstTet, FirstCube - 1) Then MsgBox "Error in tetrahedron."
  325.     If Not SameSideLengths(FirstCube, FirstOct - 1) Then MsgBox "Error in cube."
  326.     If Not SameSideLengths(FirstOct, FirstDod - 1) Then MsgBox "Error in octahedron."
  327.     If Not SameSideLengths(FirstDod, FirstIco - 1) Then MsgBox "Error in dodecahedron."
  328.     If Not SameSideLengths(FirstIco, LastIco - 1) Then MsgBox "Error in icosahedron."
  329. End Sub
  330.